Preprocessing

Are there unconscious visual images in aphantasia? Development of an implicit priming paradigm

Modified

18/09/2024


# Packages ----------------------------------------------------------------

# using a reproducible environment
renv::restore()

# pacman allows to check/install/load packages with a single call
# if (!require("pacman")) install.packages("pacman") # already in renv.lock
library("pacman")

# packages to load (and install if needed) -------------------------------
pacman::p_load(
  here,      # easy file paths
  see,       # theme_modern and okabeito palette
  report,    # reporting various info 
  labelled,  # labelled data
  # ---- packages specific to this project ----
  scales,
  lme4,
  BayesFactor,
  car,
  simr,
  readxl,
  openxlsx,
  statmod,
  qqplotr,
  emmeans,
  latex2exp,
  ggbeeswarm,
  ggpubr,
  patchwork,
  quarto,
  easystats,
  # ---
  tidyverse  # modern R ecosystem
)


# Custom functions shared across scripts ----------------------------------
source(here("scripts/_functions.R"))


# Global cosmetic theme ---------------------------------------------------

theme_set(theme_modern(base_size = 14)) # from see in easystats

# setting my favourite palettes as ggplot2 defaults
options( 
  ggplot2.discrete.colour   = scale_colour_okabeito,
  ggplot2.discrete.fill     = scale_fill_okabeito,
  ggplot2.continuous.colour = scale_colour_viridis_c,
  ggplot2.continuous.fill   = scale_fill_viridis_c
)


# Fixing a seed for reproducibility ---------------------------------------
set.seed(14051998)


# Adding all packages' citations to a .bib --------------------------------
knitr::write_bib(c(.packages()), file = here("bibliography/packages.bib"))

Down below is the code for the outlier selection procedure described in the manuscript.

Importing and cleaning questionnaire data
df_questionnaires <- 
  read_excel(
    here("data/data-raw/priming-data-raw.xlsx"),
    sheet = "data_questionnaires"
  ) |>
  mutate(
    sub_group = case_when(
      vviq80 == 16 ~ "Aphantasia",
      vviq80 > 16 & vviq80 < 32 ~ "Hypophantasia",
      vviq80 >= 32 & vviq80 < 74 ~ "Control",
      vviq80 >= 74 ~ "Hyperphantasia"
      ), 
    sub_group = factor(
      sub_group, 
      levels = c("Hyperphantasia", "Control", "Hypophantasia", "Aphantasia"))
    ) |> 
  rename(
    "VVIQ" = vviq80,
    "OSIQ_Object" = osiq_o75,
    "OSIQ_Spatial" = osiq_s75,
    "SUIS" = suis60
  )
Preprocessing for the explicit task
df_e_acc <- 
  read_excel(
    here("data/data-raw/priming-data-raw.xlsx"),
    sheet = "data_explicit"
  ) |>
  clean_variables() |> # see _functions.R
  set_variable_labels(correct_explicit = "Correct response") |> 
  # filtering out...
  filter(
    # participants identified with with high error rates
    !(subjectid %in% c( 
      "subject_7",
      "subject_94", 
      "subject_25", 
      "subject_4",
      "subject_97")) &
    # participants with aberrant means
    !(subjectid %in% c(
      "subject_49",
      "subject_59",
      "subject_107",
      "subject_100",
      "subject_73",
      "subject_106",
      "subject_119"
    )) 
  ) |>
  mutate(
    sub_group = case_when(
      vviq80 == 16 ~ "Aphantasia",
      vviq80 > 16 & vviq80 < 32 ~ "Hypophantasia",
      vviq80 >= 32 & vviq80 < 74 ~ "Control",
      vviq80 >= 74 ~ "Hyperphantasia"
    ), 
    sub_group = factor(
      sub_group, 
      levels = c("Hyperphantasia", "Control", "Hypophantasia", "Aphantasia"))
  ) |> 
  # removing irrelevant variables
  select(!c(sex, vviq80, orientation, response)) |>  
  # filtering out extreme RTs
  filter(rt > .3 & rt < 3)

df_e_rt <- 
  df_e_acc |> 
  filter(correct_explicit == 1) |> 
  select(!correct_explicit)

# removing hyperphantasia for finer analyses
df_e_finer <- df_e_rt |> filter(sub_group != "Hyperphantasia")
Preprocessing for the implicit task
df_i_acc <- 
  read_excel(
    here("data/data-raw/priming-data-raw.xlsx"),
    sheet = "data_implicit"
  ) |> 
  clean_variables() |>
  set_variable_labels(correct_implicit = "Correct response") |>
  # filtering out...
  filter(
    # participants identified with with high error rates
    !(subjectid %in% c(
      "subject_21",
      "subject_56",
      "subject_9")) &
      # participants with aberrant means
      !(subjectid %in% c(
        "subject_49",
        "subject_107",
        "subject_30",
        "subject_120",
        "subject_127"
      ))
  ) |>
  mutate(
    sub_group = case_when(
      vviq80 == 16 ~ "Aphantasia",
      vviq80 > 16 & vviq80 < 32 ~ "Hypophantasia",
      vviq80 >= 32 & vviq80 < 74 ~ "Control",
      vviq80 >= 74 ~ "Hyperphantasia"
    ), 
    sub_group = factor(
      sub_group, 
      levels = c("Hyperphantasia", "Control", "Hypophantasia", "Aphantasia"))
  ) |> 
  # removing irrelevant variables
  select(!c(sex, vviq80, orientation, response)) |>  
  # filtering out extreme RTs
  filter(rt > .3 & rt < 3)

df_i_rt <-
  df_i_acc |> 
  filter(correct_implicit == 1) |> 
  select(!correct_implicit)

# removing hyperphantasia for finer analyses
df_i_finer <- df_i_rt |> filter(sub_group != "Hyperphantasia")
Adding congruence effects to the questionnaire data
congruence_effects <-
  list(
    df_e_rt = df_e_rt,
    df_i_rt = df_i_rt
  ) |> 
  imap(
    ~.x |> 
      group_by(subjectid, congruence, color) |> 
      reframe(mean_rt = mean(rt)) |> 
      group_by(subjectid, congruence) |> 
      reframe(mean = mean(mean_rt)) |> 
      pivot_wider(
        names_from = congruence,
        values_from = mean
      ) |> 
      mutate(congruence_effect = Incongruent - Congruent, .keep = "unused") |> 
      ungroup()
  )

df_questionnaires <- 
  df_questionnaires |>
  left_join(congruence_effects[["df_e_rt"]], by = "subjectid") |>
  rename("Explicit effect" = congruence_effect) |>
  left_join(congruence_effects[["df_i_rt"]], by = "subjectid") |> 
  rename("Implicit effect" = congruence_effect) |> 
  select(
    subjectid:aphantasia, sub_group,
    contains("Imp"), contains("Exp"), 
    "VVIQ":"SUIS"
  ) |> 
  group_by(aphantasia) |> 
  mutate(across(
    contains("effect"),
    ~if_else(is.na(.x), mean(.x, na.rm = TRUE), .x))) |> 
  ungroup()
Creating ranked and normalized scores
df_q_ranked <- df_questionnaires |> mutate(across(VVIQ:SUIS, rank))

df_q_norm <- 
  df_questionnaires |>
  mutate(
    VVIQ = as.numeric(
      scales::rescale(
        VVIQ, 
        from = c(16, 80), 
        to = c(0, 1))),
    SUIS = as.numeric(
      scales::rescale(
        SUIS, 
        from = c(12, 60), 
        to = c(0, 1))),
    OSIQ_Object = as.numeric(
      scales::rescale(
        OSIQ_Object, 
        from = c(15, 75), 
        to = c(0, 1))),
    OSIQ_Spatial = as.numeric(
      scales::rescale(
        OSIQ_Spatial, 
        from = c(15, 75), 
        to = c(0., 1)))
  )

     

═════════════════════════════════════════════════════════════════════════
Analyses were conducted using the R Statistical language (version 4.4.1; R Core
Team, 2024) on Windows 11 x64 (build 22631)
Packages used:
  - quarto (version 1.4.4; Allaire J, Dervieux C, 2024)
  - qqplotr (version 0.0.6; Almeida A et al., 2018)
  - lme4 (version 1.1.35.5; Bates D et al., 2015)
  - Matrix (version 1.7.0; Bates D et al., 2024)
  - effectsize (version 0.8.9; Ben-Shachar MS et al., 2020)
  - ggbeeswarm (version 0.7.2; Clarke E et al., 2023)
  - car (version 3.1.2; Fox J, Weisberg S, 2019)
  - carData (version 3.0.5; Fox J et al., 2022)
  - statmod (version 1.5.0; Giner G, Smyth GK, 2016)
  - simr (version 1.0.7; Green P, MacLeod CJ, 2016)
  - lubridate (version 1.9.3; Grolemund G, Wickham H, 2011)
  - ggpubr (version 0.6.0; Kassambara A, 2023)
  - labelled (version 2.13.0; Larmarange J, 2024)
  - emmeans (version 1.10.3; Lenth R, 2024)
  - parameters (version 0.22.0; Lüdecke D et al., 2020)
  - performance (version 0.12.0; Lüdecke D et al., 2021)
  - easystats (version 0.7.2; Lüdecke D et al., 2022)
  - see (version 0.8.4; Lüdecke D et al., 2021)
  - insight (version 0.20.1; Lüdecke D et al., 2019)
  - bayestestR (version 0.13.2; Makowski D et al., 2019)
  - modelbased (version 0.8.8; Makowski D et al., 2020)
  - report (version 0.5.8; Makowski D et al., 2023)
  - correlation (version 0.8.5; Makowski D et al., 2022)
  - latex2exp (version 0.9.6; Meschiari S, 2022)
  - BayesFactor (version 0.9.12.4.7; Morey R, Rouder J, 2024)
  - here (version 1.0.1; Müller K, 2020)
  - tibble (version 3.2.1; Müller K, Wickham H, 2023)
  - datawizard (version 0.11.0; Patil I et al., 2022)
  - patchwork (version 1.2.0; Pedersen T, 2024)
  - coda (version 0.19.4.1; Plummer M et al., 2006)
  - R (version 4.4.1; R Core Team, 2024)
  - pacman (version 0.5.1; Rinker TW, Kurkiewicz D, 2018)
  - openxlsx (version 4.2.5.2; Schauberger P, Walker A, 2023)
  - ggplot2 (version 3.5.1; Wickham H, 2016)
  - forcats (version 1.0.0; Wickham H, 2023)
  - stringr (version 1.5.1; Wickham H, 2023)
  - tidyverse (version 2.0.0; Wickham H et al., 2019)
  - readxl (version 1.4.3; Wickham H, Bryan J, 2023)
  - dplyr (version 1.1.4; Wickham H et al., 2023)
  - purrr (version 1.0.2; Wickham H, Henry L, 2023)
  - readr (version 2.1.5; Wickham H et al., 2024)
  - scales (version 1.3.0; Wickham H et al., 2023)
  - tidyr (version 1.3.1; Wickham H et al., 2024)
═════════════════════════════════════════════════════════════════════════